Read mortality data

ACM_5_with_networks <- 
  read_excel("data/mortality/ACM-5%-networks-overlap-correction-TP.xlsx", 
                                                   sheet = "data-ACM")

studyTable <- ACM_5_with_networks %>%
  filter(!is.na(effect)) %>%
  mutate(sef = ifelse(is.na(se_Adj),1, se_Adj))  %>% #get Adjustments for common cohorts
  mutate(var = (se*sef)^2)

Get all studies

studyIds <- unique(studyTable$id)

There are 83 studies

We now check studies for variance and effect inconsistency.

studyIds <- unique(studyTable$id)
errorstudies <- c()
warnmess <- c()
studyInconsistency <- data.frame()
studyGraphs <- lapply(studyIds, function(stid){
  res <- {}
  tryCatch({
    stgr <- fullGraph(stid, studyTable ,rand=F)
    res <- stgr
  },error = function(cond){
    # print(c("error in study",stid))
    errorstudies <<- c(errorstudies,stid)
    # message(conditionMessage(cond))
  })
  return(res)
})
## Warning in treatVars(gr, spt): found negative variances in study
## 44_EPIC-Italy_d the following comparisons will be ignored in order to get
## consistent variances CHO:PP
## Warning in treatVars(gr, spt): found negative variances in study 51_PREDIMED_b
## the following comparisons will be ignored in order to get consistent variances
## MUFA:SFA,PUFA:TFA,PUFA:SFA
## Warning in treatVars(gr, spt): found negative variances in study 62_UKB_b the
## following comparisons will be ignored in order to get consistent variances
## CHO:TFA,CHO:PUFA,MUFA:SFA,MUFA:PUFA,MUFA:PRO,PRO:TFA,PRO:PUFA,PUFA:TFA,SFA:TFA
## Warning in treatVars(gr, spt): found negative variances in study 62_UKB_d the
## following comparisons will be ignored in order to get consistent variances
## CHO:PP,MUFA:PP,PP:TFA,PP:SFA,PP:PUFA
## Warning in treatVars(gr, spt): found negative variances in study 62_UKB_f the
## following comparisons will be ignored in order to get consistent variances
## MUFA:n3-PUFA,n3-PUFA:TFA,n3-PUFA:SFA,n3-PUFA:PRO,n3-PUFA:n6-PUFA
## Warning in treatVars(gr, spt): found negative variances in study 159_WHI the
## following comparisons will be ignored in order to get consistent variances
## CHO:PP
## Warning in treatVars(gr, spt): found negative variances in study 196_NIH-AARP_c
## the following comparisons will be ignored in order to get consistent variances
## MUFA-A:SFA
## Warning in treatVars(gr, spt): found negative variances in study 196_NIH-AARP_f
## the following comparisons will be ignored in order to get consistent variances
## n3-PUFA:SFA
SGs <- Filter(function(g){!is.null(g)},studyGraphs)
names(SGs)<-lapply(SGs,function(x){return(x$study)}) %>% unlist()
incgs <- Filter(function(g){g$inc & g$pvalue < 0.90},SGs)
lapply(incgs, function(g){plotDiffs(g)})

## $`82_IWHS_d`
## NULL
## 
## $`115_CHNS_c`
## NULL
## 
## $`196_NIH-AARP_b`
## NULL
## 
## $`196_NIH-AARP_c`
## NULL
## 
## $`196_NIH-AARP_f`
## NULL

Analysis and forest plots

For each network, the network plot and the forest plots of logRRs using the random effects model are shown. All results and plots are in the results directory. The R objects are saved as .rds files

report <- lapply(1:7,function(netid){
    print(paste("Network ", netid, sep=""))
    pairwiseReport(studyTable, SGs, netid, "mortality")
    netReport(studyTable, SGs, netid, "mortality")
})
## [1] "Network 1"

## [1] "Network 2"

## [1] "Network 3"

## [1] "Network 4"

## [1] "Network 5"

## [1] "Network 6"

## [1] "Network 7"

Subgroup for RoB

report <- lapply(1:7,function(netid){
    print(paste("Network ", netid, sep=""))
    netReport(studyTable, SGs, netid, "mortality", subgroup="RoB_subg")
})
## [1] "Network 1"
## [1] "Subgroup" "high"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup"      "some concerns"

## [1] "Network 2"
## [1] "Subgroup" "high"

## [1] "Subgroup"      "some concerns"

## [1] "Network 3"
## [1] "Subgroup" "high"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup"      "some concerns"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 4"
## [1] "Subgroup" "high"
## Warning in FUN(X[[i]], ...): less than 10 studies in group

## [1] "Subgroup"      "some concerns"

## [1] "Network 5"
## [1] "Subgroup" "high"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup"      "some concerns"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 6"
## [1] "Subgroup" "high"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup"      "some concerns"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 7"
## [1] "Subgroup" "high"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup"      "some concerns"
## Warning in FUN(X[[i]], ...): less than 10 studies in group

Subgroup for Location

report <- lapply(1:7,function(netid){
    print(paste("Network ", netid, sep=""))
    netReport(studyTable, SGs, netid, "mortality", subgroup="location_subg")
})
## [1] "Network 1"
## [1] "Subgroup" "europe"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "asia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup"  "australia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "mixed"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "america"

## [1] "Network 2"
## [1] "Subgroup" "europe"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "asia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup"  "australia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "mixed"
## Warning in FUN(X[[i]], ...): less than 10 studies in group

## [1] "Subgroup" "america"

## [1] "Network 3"
## [1] "Subgroup" "europe"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "asia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup"  "australia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "mixed"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "america"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 4"
## [1] "Subgroup" "europe"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "asia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup"  "australia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "mixed"
## Warning in FUN(X[[i]], ...): less than 10 studies in group

## [1] "Subgroup" "america"

## [1] "Network 5"
## [1] "Subgroup" "europe"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "asia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup"  "australia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "mixed"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "america"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 6"
## [1] "Subgroup" "europe"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "asia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup"  "australia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "mixed"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "america"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 7"
## [1] "Subgroup" "europe"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "asia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup"  "australia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "mixed"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "america"
## Warning in FUN(X[[i]], ...): less than 10 studies in group

Subgroup for multiple Diet

report <- lapply(1:7,function(netid){
    print(paste("Network ", netid, sep=""))
    netReport(studyTable, SGs, netid, "mortality", subgroup="multiplediet_subg")
})
## [1] "Network 1"
## [1] "Subgroup" "no"

## [1] "Subgroup" "yes"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 2"
## [1] "Subgroup" "no"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "yes"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 3"
## [1] "Subgroup" "no"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "yes"
## Warning in FUN(X[[i]], ...): less than 10 studies in group

## [1] "Network 4"
## [1] "Subgroup" "no"

## [1] "Subgroup" "yes"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 5"
## [1] "Subgroup" "no"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "yes"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 6"
## [1] "Subgroup" "no"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "yes"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 7"
## [1] "Subgroup" "no"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "yes"
## Warning in FUN(X[[i]], ...): less than 10 studies in group

Read the Results - Example Network 2

To access the network’s 2 results you just load results/mortality/network/mortalitynet2.rds either by the command indicated or by opening the file with rstudio

mortalityallnet2 <- readRDS("results/mortality/network/all/mortalityallnet2.rds")

Get the order of treatments

mortalityallnet2$netobj$trts
## [1] "CHO"  "MUFA" "PRO"  "PUFA" "SFA"  "TFA"

Define a custom treatment order for the forestplot

trtsOrder <- c("PUFA","PRO", "SFA", "TFA","CHO", "MUFA"  )

We have to rerun netmeta

net2 <- netmeta( TE=TE, seTE=seTE
               , treat1=treat1, treat2=treat2
               , studlab=studlab
               , data=mortalityallnet2$netobj$data
               , sm="RR"
               , seq=trtsOrder
               )

Get the league table

nl2 <- netleague(net2)
print(nl2$random)
##                        V1                      V2                      V3
## 1                    PUFA 0.9924 [0.8637; 1.1403] 0.8606 [0.8053; 0.9198]
## 2 0.9121 [0.8236; 1.0102]                     PRO 0.9810 [0.8805; 1.0930]
## 3 0.8578 [0.8054; 0.9137] 0.9404 [0.8550; 1.0345]                     SFA
## 4 0.7516 [0.6737; 0.8385] 0.8240 [0.7193; 0.9439] 0.8762 [0.7870; 0.9755]
## 5 0.8952 [0.8414; 0.9525] 0.9814 [0.8887; 1.0839] 1.0436 [0.9855; 1.1052]
## 6 0.9414 [0.8818; 1.0051] 1.0321 [0.9326; 1.1422] 1.0975 [1.0330; 1.1659]
##                        V4                      V5                      V6
## 1 0.6381 [0.5590; 0.7283] 0.8972 [0.8397; 0.9586] 0.9201 [0.8581; 0.9866]
## 2 0.9588 [0.5486; 1.6759] 1.0136 [0.8872; 1.1580] 1.0580 [0.9171; 1.2206]
## 3 0.8528 [0.7489; 0.9711] 1.0577 [0.9942; 1.1252] 1.0947 [1.0264; 1.1674]
## 4                     TFA 1.1717 [1.0477; 1.3103] 1.3525 [1.1891; 1.5384]
## 5 1.1911 [1.0736; 1.3214]                     CHO 1.0625 [0.9966; 1.1327]
## 6 1.2526 [1.1245; 1.3952] 1.0516 [0.9910; 1.1160]                    MUFA

And the forest plots will follow the order defined

 forest(net2
       , label.right="Network 2"
       , smlab=paste("RR Mortality")
       )